Shareware Super Platinum 8

home *** CD-ROM | disk | FTP | other *** search

/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / DATABASE / BORUSR2.ZIP;1 / BOREDIT.PRG < prev next >

Wrap

Text File | 1992-06-29 | 16.5 KB | 570 lines

*------------------------------------------------------------------------------- *-- Program.....: BOREDIT.PRG *-- Programmer..: Ken Mayer *-- Date........: 06/12/1992 *-- Notes.......: Used to edit data in ATUSER.DBF *-- Written for.: dBASE IV, 1.1/1.5 *-- Rev. History: 11/26/1991 -- added use of Martin's PICKLIST routine, to *-- allow a user to ask for people by STATE. This will bring *-- up a list of just those AT/BOR-BBS users for that state. *-- 05/14/1992 -- Added delete routine to THIS, rather than *-- having a separate delete routine. *-- 06/12/1992 -- I believe I have cleared up some of the color *-- problems in version 1.5 of dBASE that I was having. A few *-- other minor changes (like renaming the programs, etc.). *------------------------------------------------------------------------------- save screen to sEdit cEdtColor = set("ATTRIBUTES") clear x=scrnhead("&cStand2","BOR-BBS Users Database - Search/Update Data") *-- 03/27/1992 -- network() function included to deal with *-- exclusive/non-exclusive use of database on *-- a network if network() use atusers excl else use atusers endif lPgUp = .f. && used if user presses <PgUp> in second screen ... *-- window for 'bio' field define window wBio from 9,10 to 20,79 do while .t. && loop for menu/search routines lOk = .f. @5,0 clear @4,67 clear to 4,79 && clean out any 'deleted' messages that might && be left cChoice = VPick(8,30,"~Borland BBS ID~Last Name~State","Search By:",; "Select one, or <Esc> to return to menu",.t.,; "&cStand2,&cStand,&cStand2") *-- if user pressed <Esc> to exit the popup ... if IsBlank(cChoice) && user pressed <Esc> exit && we done endif *----------------------------------------------------------------------- *-- Choices from above ... *----------------------------------------------------------------------- do case case cChoice = "B" && look by AT/BBS Id cTest = space(9) set order to tag borbbs_id @10,10 say "Enter BOR BBS Id: " get cTest picture "@!" read *-- check for <Esc> key if lastkey() = 27 loop endif *-- user press <Enter>? If NOT, look for it ... if .not. IsBlank(cTest) seek trim(cTest) lOK = .f. else loop endif *-- we didn't find one that matched ... if .not. found() x=errormsg("","Could not find record","","&cStand3") loop endif *-- found one, display, if not that one, try another ??? do while upper(trim(borbbs_id)) = trim(cTest) @12,8 SAY "BORBBS ID:" @12,19 GET Borbbs_id PICTURE "@!" @13,13 SAY "Name:" @13,19 GET First_name picture "!XXXXXXXXXXXXXXXXXXXXXXXX" @13,45 GET Mi PICTURE "!" message "Middle Initial" @13,47 GET Last_name picture "!XXXXXXXXXXXXXXXXXXXXXXXX"; message "Last Name" @14,8 SAY "Honorific:" @14,19 GET Honorific PICTURE "!XXXXX"; message "Honorific (Mr., Mrs., Ms., Dr., etc.)" clear gets if yesno2(.t.,"BC","Is this the one?","","","&cl_wind1") store .t. to lOK exit else store .f. to lOK skip && if this ain't it, skip to next record, and loop && go back and check again ... endif enddo case cChoice = "L" && check by Last Name cTest = space(25) set order to tag last_name @10,10 say "Enter Last Name: " get cTest picture "@!" read *-- check for <Esc> key if lastkey() = 27 loop endif *-- user press <Enter>? If NOT, look for it ... if .not. IsBlank(cTest) seek trim(cTest) lOK = .f. else loop endif *-- we didn't find one that matched ... if .not. found() x=errormsg("","Could not find record","","&cl_wind2") loop endif *-- found one, display, if not that one, try another ??? do while trim(upper(last_name)) = trim(cTest) @12,8 SAY "BORBBS ID:" @12,19 GET Borbbs_id PICTURE "@!" @13,13 SAY "Name:" @13,19 GET First_name picture "!XXXXXXXXXXXXXXXXXXXXXXXX" @13,45 GET Mi PICTURE "!" message "Middle Initial" @13,47 GET Last_name picture "!XXXXXXXXXXXXXXXXXXXXXXXX"; message "Last Name" @14,8 SAY "Honorific:" @14,19 GET Honorific PICTURE "!XXXXX"; message "Honorific (Mr., Mrs., Ms., Dr., etc.)" clear gets if yesno2(.t.,"BC","Is this the one?","","","&cl_wind1") store .t. to lOK exit else store .f. to lOK skip loop endif enddo && end of search ... case cChoice = "S" && state cTest = space(2) set order to tag state @10,10 say "Enter State: " get cTest picture "@!" read *-- Check for <Esc> key if lastkey() = 27 loop endif *-- user press <Enter>? If NOT, look for it ... if .not. IsBlank(cTest) locate for hState = cTest .or. bState = cTest && home or business lOK = .f. else loop endif *-- we didn't find one that matched ... if .not. found() x=errormsg("","Could not find record","","&cl_wind2") loop endif *-- now for the fun part ... if here, we found one ... are there *-- more? nRecNo = recno() count to nCount for hState = cTest .or. bState = cTest if nCount = 1 && if only one record ... goto nRecNo @12,8 SAY "BORBBS ID:" @12,19 GET Borbbs_id PICTURE "@!" @13,13 SAY "Name:" @13,19 GET First_name picture "!XXXXXXXXXXXXXXXXXXXXXXXX" @13,45 GET Mi PICTURE "!" message "Middle Initial" @13,47 GET Last_name picture "!XXXXXXXXXXXXXXXXXXXXXXXX"; message "Last Name" @14,8 SAY "Honorific:" @14,19 GET Honorific PICTURE "!XXXXX"; message "Honorific (Mr., Mrs., Ms., Dr., etc.)" clear gets if yesno2(.t.,"BC","Is this the one?","","","&cl_wind1") store .t. to lOK else store .f. to lOK endif else && there's more than one, bring up a picklist ... && this is a bit slower than I'd like, but since we have to && be flexible enough to deal with the fact that some users && may not want to give either home or state, we need to look && at both business state AND home state (and some might work && across state lines, I suppose ...). set filter to bstate = cTest .or. hstate = cTest set order to last_name go top *-- do a picklist ... save screen to sPick do shadow with 11,7,20,72 do picklist with ; "borbbs_id+' ≥ '+left(first_name,15)+' ≥ '+left(last_name,15)"+; "+' ≥ '+iif(len(trim(hcity))>0,hcity,bcity)",; 11,7,20,72,"&cstand2","&cStand","DOUBLE" restore screen from sPick release screen sPick set order to if lastkey() = 27 && user pressed <Esc> lOK = .f. && must not have liked what they saw set filter to loop else lOK = .t. && ok, this is fine ... endif set filter to endif && nCount = 1 endcase && type of search *-- if memvar lOK is false, we still didn't find it ... if .not. lOK x=errormsg("","Could not find record","","&cl_wind2") loop endif *----------------------------------------------------------------------- *-- if we go into this loop, we've found a match ... *----------------------------------------------------------------------- on key label alt-d do delrec && routine to delete/recall a record on key label f2 do memoview && routine below to deal with VIEWing the memo lDone2 = .f. do while .t. && main loop once search is complete ... if lPgUp && if user pressed <PgUp> to get here, turn it off lPgUp = .f. endif lDone = .f. && this must be defined SOMEWHERE ... *-- set deleted flag (on screen) if deleted() @4,67 say "DELETED" color &cStand3 else @4,67 clear to 4,79 endif *----------------------------------------------------------------------- *-- SCREEN 1 *----------------------------------------------------------------------- do while .t. && first screen @5,0 clear @ 6, 8 SAY "BORBBS ID:" @ 6,19 GET Borbbs_id PICTURE "@!" @ 7,13 SAY "Name:" @ 7,19 GET First_name picture "!XXXXXXXXXXXXXXXXXXXXXXXX" @ 7,45 GET Mi PICTURE "!" message "Middle Initial" @ 7,47 GET Last_name picture "!XXXXXXXXXXXXXXXXXXXXXXXX"; message "Last Name" @ 8, 8 SAY "Honorific:" @ 8,19 GET Honorific PICTURE "!XXXXX"; message "Honorific (Mr., Mrs., Ms., Dr., etc.)" @ 8,26 say "Bio:" @ 8,31 get bio window wBio; message; "Interests of user: <Ctrl><Home> = enter/edit,<Ctrl><End> = save, <F2>=view" @ 10,10 SAY "Company:" @ 10,19 GET Company message "" @ 11,12 SAY "Title:" @ 11,19 GET Title message "Enter Job Title" @ 12,10 SAY "Address:" @ 12,19 GET Baddress1 @ 13,19 GET Baddress2 message "Enter if second address line necessary"; when .not. isblank(bAddress1) @ 14,19 GET Bcity message "City" @ 14,44 SAY "," @ 14,46 GET Bstate PICTURE "!!" message "State"; valid required state(bState) @ 14,50 GET Bzip PICTURE "#####-####" message "Zip" @ 15, 7 SAY "Work Phone:" @ 15,19 GET Bphone PICTURE "@R (999) 999-9999" @ 15,36 SAY "Fax:" @ 15,41 GET Fax PICTURE "@R (999) 999-9999" @ 17,13 SAY "Home:" @ 17,19 GET Haddress1 @ 18,19 GET Haddress2 message "Enter if second address line necessary"; when .not. isblank(hAddress2) @ 19,19 GET Hcity message "City" @ 19,44 SAY "," @ 19,46 GET Hstate PICTURE "!!" message "State"; valid required state(hState) @ 19,50 GET Hzip PICTURE "#####-####" message "Zip" @ 20, 7 SAY "Home Phone:" @ 20,19 GET Hphone PICTURE "@R (999) 999-9999" @ 21, 8 SAY "BBS Phone:" @ 21,19 GET Bbsphone PICTURE "@R (999) 999-9999" do center with 22,80,"&cStand3",; "Press <Alt>D to "+iif(.not. deleted(),"delete","recall") do center with 23,80,"&cStand3",; "Press <PgDn> for next screen" read nI = readkey() if nI > 255 nI = nI - 256 endif *-- if record not changed, and <PgDn>/<Ctrl><End> key was pressed ... if readkey() < 255 .and. (lastkey() = 3 .or. lastkey() = 23) lDone = .f. && just making sure ... exit endif *-- if user pressed <Esc> if lastkey() = 27 lDone = .t. exit endif *-- check for and process <Ctrl><End> if nI+256 = 270 && ^<end> or ^w @22,0 clear cYN = "N" @23,25 say "Finished with this record?" get cYN picture "!"; valid required cYN $ "YN"; error chr(7)+"Enter 'Y' or 'N'" read if cYN = "Y" lDone2 = .t. exit else lDone2 = .f. exit endif endif *-- check to see if this is alright @22,0 clear cYN = "Y" @23,25 say "Is this screen ok? " get cYN picture "!"; valid required cYN $ "YN"; error chr(7)+"Enter 'Y' or 'N'" read *-- if so, exit ... if cYN = "Y" exit endif enddo && end of first screen *----------------------------------------------------------------------- *-- SCREEN 2 *----------------------------------------------------------------------- do while .t. && second screen if lDone .or. lDone2 && if <Esc> was pressed in previous screen ... exit endif @5,0 clear @ 6, 8 SAY "BORBBS ID:" @ 6,19 get Borbbs_id @ 7,13 SAY "Name:" @ 7,19 get First_name @ 7,45 GET Mi @ 7,47 GET Last_name clear gets && these (above) are display only @ 9, 7 SAY "CompuServe:" @ 9,19 GET Compuserve @ 10, 9 SAY "MCI_Mail:" @ 10,19 GET Mci_mail @ 11,12 SAY "GEnie:" @ 11,19 GET Genie @ 12,13 SAY "FIDO:" @ 12,19 GET Fido @ 13, 9 SAY "InterNet:" @ 13,19 GET Internet @ 14,11 SAY "Source:" @ 14,19 GET Source @ 15,10 SAY "Prodigy:" @ 15,19 GET Prodigy @ 16,11 SAY "Delphi:" @ 16,19 GET Delphi @ 17, 3 SAY "America OnLine:" @ 17,19 GET Am_online do center with 21,80,"&cStand3","Press <PgUp> for previous screen" do center with 22,80,"&cStand3",; "Press <Alt>D to "+iif(.not. deleted(),"delete","recall") do center with 23,80,"&cStand3",; "Press <PgDn> or <Ctrl><End> to complete/exit this record" read *-- if user pressed <PgUp> if lastkey() = 18 lPgUp = .t. exit endif *-- if <Esc> if lastkey() = 27 lDone = .t. exit endif *-- ask if screen ok @21,0 clear cYN = "Y" @23,25 say "Is this screen ok? " get cYN picture "!"; valid required cYN $ "YN"; error chr(7)+"Enter 'Y' or 'N'" read *-- if so, exit if cYN = "Y" exit endif enddo && while .t. -- second screen *-------------------------------------------------------------------- *-- End of SCREEN Processing *-------------------------------------------------------------------- if lDone && if <Esc> was pressed ... exit endif if lPgUp && user hit <PgUp> on second screen? loop else exit endif enddo && end of first level loop -- handles <PgUp> ... on key label alt-d && turn this off, so we don't get WEIRD results ... on key label f2 && turn this off, also ... *-- check for more records ... if yesno(.f.,"More?","Do you wish to edit","another record?",; "&cl_wind1") loop else exit endif enddo && while .t. -- absolute outside loop for menu/search *-------------------------------------------------------------------------- *-- CLEANUP *-------------------------------------------------------------------------- @22,0 clear *-- deal with any deleted records ... count to nCount for deleted() if nCount > 0 *-- a little additional code from Joey Carroll (JOEY) -- allow user *-- to not HAVE to pack the data at this time ... cCount = ltrim(str(nCount)) if yesno2(.t.,"BC","Your database contains",; cCount+" marked deleted record(s).",; "Remove them now?","&cl_wind2") do center with 23,80,"&cStand3","... Deleting Marked Records ..." pack endif release cCount endif *-- cleanup close database restore screen from sEdit release screen sEdit do ReColor with cEdtColor *-------------------------------------------------------------------------- *-- back to menu ... *-------------------------------------------------------------------------- RETURN *-- Deal with 'deleting' records ... PROCEDURE DelRec on key label alt-d ?? chr(7) && disallow pressing key until done with this && routine if .not. deleted() && if delete flag is OFF if yesno2(.f.,"BC","Delete Record?","Do you really want to",; "delete this record?","&cl_wind2") delete && this record endif else if yesno2(.f.,"BC","UnMark Record?","Do you really want to",; "undelete this record?","&cl_wind2") *-- processing is a bit odd to ensure that the RECALL takes, we must *-- move the pointer back and forth ... nRec = recno() go nRec+iif(nRec > 1,-1,1) go nRec recall && <-- this command actually recalls the record ... go nRec+iif(nRec > 1,-1,1) go nRec endif endif *-- set/reset DELETED flag ... if deleted() @4,67 say "DELETED" color &cStand3 else @4,67 clear to 4,79 endif *-- change message on screen ... do center with 22,80,"&cStand3",; "Press <Alt>D to "+iif(.not. deleted(),"delete","recall") on key label alt-d do delrec && reset ... RETURN *-- EoP: DelRec PROCEDURE MemoView && uses Martin Leon's MEMOPAGR routine (currently residing && in PROC.PRG on key label f2 ?? chr(7) save screen to sMemoView define window wMemotext from 20,10 to 22,70 double color &cl_Wind1 do shadow with 20,10,22,70 activate window wMemoText do center with 0,60,"&cStand2","Use arrow keys to scroll, <Esc> when done." activate screen x=memopagr("bio",9,10,18,77) deactivate window wMemoText restore screen from sMemoView release window wMemoText release screen sMemoView on key label f2 do memoview RETURN *------------------------------------------------------------------------------- *-- EoP: BOREDIT.PRG *-------------------------------------------------------------------------------